perm filename VECC[206,LSP] blob sn#092769 filedate 1974-03-21 generic text, type T, neo UTF8

(DEFPROP VECF
 (VECF PRNUM VECCOD DOOUT TEST TEXLIN VEC)
VALUE)

(DEFPROP PRNUM
 (LAMBDA(N K)
  (COND ((LESSP K 2) (TYO (REMAINDER N 200))) (T (PRNUM (QUOTIENT N 200) (SUB1 K)) (TYO (REMAINDER N 200)))))
EXPR)

(DEFPROP VECCOD
 (LAMBDA (Y0 X0 DX N W) (TYO 177) (TYO 4) (PRNUM Y0 2) (PRNUM X0 2) (PRNUM DX 3) (PRNUM N 2) (PRNUM W 2))
EXPR)

(DEFPROP DOOUT
 (LAMBDA (L) (OUTC T NIL) (MAPC (FUNCTION EVAL) L) (OUTC NIL NIL))
FEXPR)

(DEFPROP TEST
 (LAMBDA(Y0 X0 DX N W)
  (OUTC T NIL)
  (TEXLIN 620)
  (PRINC (QUOTE ABCDEF))
  (TERPRI)
  (VECCOD Y0 X0 DX N W)
  (TEXLIN 2424)
  (PRINC (QUOTE ZYXWVU))
  (TERPRI)
  (OUTC NIL T))
EXPR)

(DEFPROP TEXLIN
 (LAMBDA (N) (PRINC (ASCII 177)) (PRINC (ASCII 3)) (PRNUM N 2))
EXPR)

(DEFPROP VEC
 (LAMBDA(X1 Y1 X2 Y2)
  (PROG	(DX N W)
	(SETQ N (ADD1 (DIFFERENCE Y2 Y1)))
	(SETQ DX (COND ((LESSP X1 X2) (DIFFERENCE X2 X1)) (T (DIFFERENCE X1 X2))))
	(SETQ W (ADD1 (QUOTIENT DX N)))
	(VECCOD	Y1
		(COND ((LESSP X2 X1) (DIFFERENCE X1 W)) (T X1))
		(PLUS (QUOTIENT (TIMES DX 1000) N) (COND ((LESSP X2 X1) 4000000) (T 0)))
		N
		W)))
EXPR)